﻿
namespace Octopus.OctopusSetupCustomAction

open System
open System.Diagnostics
open System.Configuration.Install
open System.Management


type Win32ServiceReturns =
| Success = 0
| NotSupported = 1
| AccessDenied = 2
| DependentServicesRunning = 3
| InvalidServiceControl = 4
| ServiceCannotAcceptControl = 5
| ServiceNotActive = 6
| ServiceRequestTimeout = 7
| UnknownFailure = 8
| PathNotFound = 9
| ServiceAlreadyRunning = 10
| ServiceDatabaseLocked = 11
| ServiceDependencyDeleted = 12
| ServiceDependencyFailure = 13
| ServiceDisabled = 14
| ServiceLogonFailure = 15
| ServiceMarkedForDeletion = 16
| ServiceNoThread = 17
| StatusCircularDependency = 18
| StatusDuplicateName = 19
| StatusInvalidName = 20
| StatusInvalidParameter = 21
| StatusInvalidServiceAccount = 22
| StatusServiceExists = 23
| ServiceAlreadyPaused = 24 


module Win32_Service =

  let private jobCompleted (outParams:ManagementBaseObject) scope =
    let jobPath = outParams.["Job"] :?> string
    use job = new ManagementObject(scope, new ManagementPath(jobPath), null)
    job.Get() // Try to get storage job information
    while (job.["JobState"] :?> uint16) = 3us (*uint16(JobState.Starting)*) || (job.["JobState"] :?> uint16) = 4us (*uint16(JobState.Running)*) do
      System.Threading.Thread.Sleep(1000)
      job.Get()
    // Figure out if job failed
    let jobState = job.["JobState"] :?> uint16
    if jobState <> 7us then     // JobState.Completed
      let jobErrorCode = job.["ErrorCode"] :?> uint16
      failwithf "Error Code: %d, ErrorDescription: %s" jobErrorCode (job.["ErrorDescription"].ToString())

  let createService (name:string) (displayName:string) (pathName:string) (serviceDependencies:string array) =
    let scope = new ManagementScope(@"root\cimv2", null)
    let imageService = new ManagementClass(scope, new ManagementPath("Win32_Service"), null)
    use inParams = imageService.GetMethodParameters("Create")
    inParams.["Name"] <- name
    inParams.["DisplayName"] <- displayName
    inParams.["PathName"] <- pathName
    inParams.["ServiceType"] <- 0x10us   // Own Process
    inParams.["ErrorControl"] <- 0us     // User is not notified
    inParams.["StartMode"] <- "Automatic"
    inParams.["DesktopInteract"] <- false
    inParams.["StartName"] <- "LocalSystem"
    inParams.["StartPassword"] <- ""
    inParams.["ServiceDependencies"] <- serviceDependencies
    use outParams = imageService.InvokeMethod("Create", inParams, null)
    let code = outParams.["ReturnValue"] :?> uint32
    match code with
    | 0u -> ()                                  // ReturnCode.Completed
    //| 4096u -> jobCompleted outParams scope     // ReturnCode.Started
    | _ -> failwithf "Unable to create the service. Error %d" code

  let startService (name:string) =
    let objPath = sprintf "Win32_Service.Name='%s'" name
    use service = new ManagementObject(new ManagementPath(objPath))
    try
      let outParam = service.InvokeMethod("StartService", null, null)
      let code = outParam.["ReturnValue"] :?> uint32
      match code with
      | 0u -> ()                                  // ReturnCode.Completed
      | _ -> let cc = enum<Win32ServiceReturns> (int code) in failwithf "Unable to start the service. Error (%d) %s" code (string cc)
    with _ ->
      failwith "Unable to start the service."

  let stopService (name:string) =
    let objPath = sprintf "Win32_Service.Name='%s'" name
    use service = new ManagementObject(new ManagementPath(objPath))
    try
      let outParam = service.InvokeMethod("StopService", null, null)
      let code = outParam.["ReturnValue"] :?> uint32
      match code with
      | 0u -> ()                                  // ReturnCode.Completed
      | _ -> let cc = enum<Win32ServiceReturns> (int code) in failwithf "Unable to stop the service. Error (%d) %s" code (string cc)
    with _ ->
      failwith "Unable to stop the service."
    
  let existsService (name:string) =
    let objPath = sprintf "Win32_Service.Name='%s'" name
    use service = new ManagementObject(new ManagementPath(objPath))
    try
      service.InvokeMethod("InterrogateService", null, null) |> ignore
      true
    with _ ->
      false

  let interrogateService (name:string) =
    let objPath = sprintf "Win32_Service.Name='%s'" name
    use service = new ManagementObject(new ManagementPath(objPath))
    try
      let outParam = service.InvokeMethod("InterrogateService", null, null)
      let code = outParam.["ReturnValue"] :?> uint32
      enum<Win32ServiceReturns> (int code)
    with _ ->
      failwith "Failed"

  let deleteService (name:string) =
    let objPath = sprintf "Win32_Service.Name='%s'" name
    use service = new ManagementObject(new ManagementPath(objPath))
    try
      let outParam = service.InvokeMethod("Delete", null, null)
      let code = outParam.["ReturnValue"] :?> uint32
      match code with
      | 0u -> ()                                  // ReturnCode.Completed
      | _ -> let cc = enum<Win32ServiceReturns> (int code) in failwithf "Unable to delete the service. Error (%d) %s" code (string cc)
    with _ ->
      failwith "Unable to delete the service."



module Octopus_Win32Service =
  let serviceName = "OctopusScheduler"
  let startService () = Win32_Service.startService serviceName
  let stopService () = Win32_Service.stopService serviceName
  let existsService () = Win32_Service.existsService serviceName
  let interrogateService () = Win32_Service.interrogateService serviceName
  let deleteService () = Win32_Service.deleteService serviceName




[<System.ComponentModel.RunInstaller(true)>]
type OctopusInstaller =
  inherit System.Configuration.Install.Installer

  member private x.serviceName = "OctopusScheduler"
  member private x.serviceDisplayName = "Octopus Scheduler"
  member private x.serviceBinName = "VmSchedulerService.exe"

  /// <summary>
  /// Target dir of the project. 
  /// It Is not null only if the TargetDir custom data is specified.
  /// </summary>
  member private x.TargetDir
      with get() =
        if not(x.Context.Parameters.ContainsKey("TargetDir")) then null
        else
          let tmp = let t = x.Context.Parameters.["TargetDir"] in if t.EndsWith(@"\") then t else (t + @"\")
          if tmp.StartsWith(@"\") && not( tmp.StartsWith(@"\\") ) then (@"\" + tmp)
          else tmp


  override x.Install savedState =
      base.Install(savedState)
      // ---
      if not( Win32_Service.existsService "MSSQL$SQLEXPRESS" ) then
        failwith "SQLEXPRESS database not found. Unable to install octopus"
      
      if x.TargetDir = null then
        failwith "Unable to install: TargetDir not set"

      try
        let copyStream (s1:System.IO.Stream) (s2:System.IO.Stream) =
          let buf = Array.zeroCreate<byte> 4096
          let rec doCopy () =
            let len = s1.Read(buf, 0, 4096)
            if len > 0 then
              s2.Write(buf, 0, len)
              doCopy ()
            else
              ()
          doCopy()

        let clipslibfile = x.TargetDir + "CLIPSLib.dll"
        let clipsdllfile = x.TargetDir + "CLIPSNet.dll"
        let clipszipfile = x.TargetDir + "Clips64.zip"
        System.IO.File.Delete(clipslibfile)
        System.IO.File.Delete(clipsdllfile)
        let zip = System.IO.Packaging.ZipPackage.Open(clipszipfile, System.IO.FileMode.Open, System.IO.FileAccess.Read)
        let parts = [| for p in zip.GetParts() -> p |]
        for p in parts do
          let partStream = p.GetStream();
          let fileName = if p.Uri.OriginalString.StartsWith("/") || p.Uri.OriginalString.StartsWith(@"\") then p.Uri.OriginalString.Substring(1) else p.Uri.OriginalString
          let fileName = x.TargetDir + fileName
          let fileStream = new System.IO.FileStream(fileName, System.IO.FileMode.Create, System.IO.FileAccess.Write)
          copyStream partStream fileStream
          fileStream.Dispose()
          partStream.Dispose()
        zip.Close()
        System.IO.File.Delete(clipszipfile)
      with e ->
        failwithf "Unable to install CLIPS 64bit libraries: %s" e.Message
      
      let binPath = x.TargetDir + x.serviceBinName
      Win32_Service.createService x.serviceName x.serviceDisplayName binPath [| "MSSQL$SQLEXPRESS" |]
      try
        Win32_Service.startService x.serviceName
      with _ -> ()


  override x.OnBeforeUninstall savedState =
      base.OnBeforeUninstall(savedState)
      // ---
      try
        Win32_Service.stopService x.serviceName
      with _ -> ()
      try
        Win32_Service.deleteService x.serviceName
      with _ -> ()


  new () = {}